open-powerlifting-GAM

setup

rm(list = ls())
library(tidyverse)
library(ggplot2)
library(car)
library(scam)

download data

if (file.exists("openpowerlifting-2020-06-20/openpowerlifting-2020-06-20.csv")){
  data.working <- read.csv("openpowerlifting-2020-06-20/openpowerlifting-2020-06-20.csv")
} else {
  download.file("https://github.com/sstangl/openpowerlifting-static/raw/gh-pages/openpowerlifting-latest.zip",
              "openpowerlifting-latest.zip")
  unzip("openpowerlifting-latest.zip")
  
  data.working <- read.csv("openpowerlifting-2020-06-20/openpowerlifting-2020-06-20.csv")
}

summarize data

summary(data.working)

     Name               Sex               Event            Equipment              Age           AgeClass         BirthYearClass       Division        
 Length:1979433     Length:1979433     Length:1979433     Length:1979433     Min.   : 0.0     Length:1979433     Length:1979433     Length:1979433    
 Class :character   Class :character   Class :character   Class :character   1st Qu.:21.0     Class :character   Class :character   Class :character  
 Mode  :character   Mode  :character   Mode  :character   Mode  :character   Median :28.0     Mode  :character   Mode  :character   Mode  :character  
                                                                             Mean   :31.4                                                             
                                                                             3rd Qu.:39.5                                                             
                                                                             Max.   :98.0                                                             
                                                                             NA's   :865345                                                           
  BodyweightKg    WeightClassKg         Squat1Kg          Squat2Kg          Squat3Kg          Squat4Kg        Best3SquatKg       Bench1Kg      
 Min.   : 15.10   Length:1979433     Min.   :-555.0    Min.   :-580.0    Min.   :-600.5    Min.   :-550.0    Min.   :-477.5   Min.   :-502.5   
 1st Qu.: 67.00   Class :character   1st Qu.:  87.5    1st Qu.:  70.0    1st Qu.:-162.5    1st Qu.:-110.0    1st Qu.: 122.5   1st Qu.:  56.7   
 Median : 81.92   Mode  :character   Median : 145.0    Median : 145.0    Median : 110.0    Median : 130.0    Median : 170.0   Median : 105.0   
 Mean   : 84.11                      Mean   : 113.0    Mean   :  92.4    Mean   :  31.7    Mean   :  68.9    Mean   : 175.1   Mean   :  83.7   
 3rd Qu.: 99.00                      3rd Qu.: 200.0    3rd Qu.: 205.0    3rd Qu.: 192.5    3rd Qu.: 201.0    3rd Qu.: 220.0   3rd Qu.: 145.0   
 Max.   :260.20                      Max.   : 555.0    Max.   : 577.5    Max.   : 560.0    Max.   : 505.5    Max.   : 580.0   Max.   : 467.5   
 NA's   :27067                       NA's   :1498188   NA's   :1503907   NA's   :1517871   NA's   :1974491   NA's   :605421   NA's   :1241513  
    Bench2Kg          Bench3Kg          Bench4Kg        Best3BenchKg     Deadlift1Kg       Deadlift2Kg       Deadlift3Kg       Deadlift4Kg     
 Min.   :-575.0    Min.   :-575.0    Min.   :-500.0    Min.   :-522.5   Min.   :-461.0    Min.   :-470.0    Min.   :-587.5    Min.   :-461.0   
 1st Qu.: -50.0    1st Qu.:-137.5    1st Qu.:-128.0    1st Qu.:  75.0   1st Qu.: 125.0    1st Qu.: 115.0    1st Qu.:-207.5    1st Qu.:-117.5   
 Median :  95.0    Median : -60.0    Median :  75.0    Median : 115.0   Median : 180.0    Median : 177.5    Median : 117.5    Median : 143.0   
 Mean   :  55.2    Mean   : -18.2    Mean   :  22.2    Mean   : 118.2   Mean   : 160.9    Mean   : 130.1    Mean   :  15.2    Mean   :  75.4   
 3rd Qu.: 145.0    3rd Qu.: 117.5    3rd Qu.: 156.2    3rd Qu.: 152.5   3rd Qu.: 225.0    3rd Qu.: 230.0    3rd Qu.: 205.0    3rd Qu.: 208.5   
 Max.   : 487.5    Max.   : 478.5    Max.   : 487.6    Max.   : 488.5   Max.   : 450.0    Max.   : 460.4    Max.   : 457.5    Max.   : 440.5   
 NA's   :1250750   NA's   :1273724   NA's   :1966266   NA's   :227920   NA's   :1444994   NA's   :1455794   NA's   :1479964   NA's   :1966724  
 Best3DeadliftKg     TotalKg          Place                Dots            Wilks         Glossbrenner       Goodlift         Tested         
 Min.   :-410.0   Min.   :   1.0   Length:1979433     Min.   :  0.68   Min.   :  0.67   Min.   :  0.64   Min.   :  0.50   Length:1979433    
 1st Qu.: 140.0   1st Qu.: 217.7   Class :character   1st Qu.:167.30   1st Qu.:166.56   1st Qu.:156.78   1st Qu.: 51.98   Class :character  
 Median : 188.2   Median : 369.7   Mode  :character   Median :303.25   Median :302.34   Median :282.75   Median : 63.31   Mode  :character  
 Mean   : 189.1   Mean   : 388.8                      Mean   :283.48   Mean   :282.47   Mean   :266.23   Mean   : 63.77                     
 3rd Qu.: 235.0   3rd Qu.: 540.0                      3rd Qu.:375.80   3rd Qu.:374.24   3rd Qu.:354.59   3rd Qu.: 75.01                     
 Max.   : 460.4   Max.   :1407.5                      Max.   :795.22   Max.   :793.33   Max.   :756.90   Max.   :146.49                     
 NA's   :515012   NA's   :146611                      NA's   :163883   NA's   :163883   NA's   :163883   NA's   :305726                     
   Country           Federation        ParentFederation       Date           MeetCountry         MeetState           MeetTown        
 Length:1979433     Length:1979433     Length:1979433     Length:1979433     Length:1979433     Length:1979433     Length:1979433    
 Class :character   Class :character   Class :character   Class :character   Class :character   Class :character   Class :character  
 Mode  :character   Mode  :character   Mode  :character   Mode  :character   Mode  :character   Mode  :character   Mode  :character  
                                                                                                                                     
                                                                                                                                     
                                                                                                                                     
                                                                                                                                     
   MeetName        
 Length:1979433    
 Class :character  
 Mode  :character  
                   
                   
                   
                   

filter data

data.working <- data.working %>%
  filter(Event == "SBD",
         Equipment == "Raw",
         !is.na(Age),
         !is.na(BodyweightKg),
         !is.na(TotalKg),
         ParentFederation == "IPF")

creating features

data.working <- data.working %>%
  mutate(AgeBucket = as.factor(case_when(
         Age <= 19 ~ "Younger",
         Age >= 20 & Age <= 23 ~ "Junior",
         Age >= 24 & Age <= 35 ~ "Open",
         Age >= 36 ~ "Master",
         TRUE ~ "ERROR"))) %>%
  mutate(Federation = as.factor(Federation))
# Adding weightclass
data.working$WeightclassKg_Calc <- "error"
data.working[data.working$Sex == "M","WeightclassKg_Calc"] <- data.working %>% 
  filter(Sex == "M") %>%
  transmute(WeightclassKg_Calc = as.character(cut(BodyweightKg,
                                  c(0,53,59,66,74,83,93,105,120,9999))))
data.working[data.working$Sex == "F","WeightclassKg_Calc"] <- data.working %>% 
  filter(Sex == "F") %>%
  transmute(WeightclassKg_Calc = as.character(cut(BodyweightKg,
                                  c(0,43,47,52,57,63,72,84,9999))))
data.working$WeightclassKg_Calc <- as.factor(data.working$WeightclassKg_Calc)

weightclasses <- unique(data.working$WeightclassKg_Calc)

intra-weightclass scam

monotone increasing concave --> bs = "micv"

for (each in weightclasses){

Warning messages:
1: In readChar(file, size, TRUE) : truncating string with embedded nuls
2: In readChar(file, size, TRUE) : truncating string with embedded nuls
3: In readChar(file, size, TRUE) : truncating string with embedded nuls
4: In readChar(file, size, TRUE) : truncating string with embedded nuls
5: In readChar(file, size, TRUE) : truncating string with embedded nuls

  
  df_tmp <- data.working %>%
    filter(WeightclassKg_Calc == each) %>%
    select(TotalKg, BodyweightKg)
  
  scam_tmp <- scam(data = df_tmp,
                   TotalKg ~ s(BodyweightKg, bs = "mpi"))
  
  df_tmp$scam_predict <- predict(scam_tmp)
  
  print(ggplot(df_tmp) +
    geom_point(aes(x = BodyweightKg, y = TotalKg)) +
    geom_line(aes(x = BodyweightKg, y = scam_predict), color = "blue", size = 2) +
    ggtitle(paste(each, ": Raw with GAM")))
  
  data.working[data.working$WeightclassKg_Calc == each, "TotalKg_scam"] <- data.working[data.working$WeightclassKg_Calc == each, "TotalKg"] / df_tmp$scam_predict
  
  print(ggplot(data.working %>% filter(WeightclassKg_Calc == each)) +
    geom_point(aes(x = BodyweightKg, y = TotalKg_scam)) +
    ggtitle(paste(each, ": Transformed")))
}

ggplot(data.working %>% filter(Sex == "M")) +
  geom_point(aes(x = BodyweightKg, y = TotalKg_scam))

ggplot(data.working %>% filter(Sex == "F")) +
  geom_point(aes(x = BodyweightKg, y = TotalKg_scam))

box-cox

box_cox_df <- matrix(ncol = 2,
                     nrow = length(unique(data.working$WeightclassKg_Calc)))
# dataframe of optimal lambdas
for (x in 1:length(weightclasses)){
  tmp <- data.working %>% filter(WeightclassKg_Calc == weightclasses[x])
  box_cox_df[x,1] <- as.character(weightclasses[x])
  box_cox_df[x,2] <- powerTransform(tmp$TotalKg_scam)$lambda
}
box_cox_df <- as.data.frame(box_cox_df)
colnames(box_cox_df) <- c("WeightclassKg", "lambda")
box_cox_df$WeightclassKg <- as.character(box_cox_df$WeightclassKg)
box_cox_df$lambda <- as.numeric(box_cox_df$lambda)
box_cox_df

# applying box-cox w/ said optimal lambda
data.working$SCORE <- 0
for (each in weightclasses){
  x = data.working[data.working$WeightclassKg_Calc == each,"TotalKg_scam"]
  data.working[data.working$WeightclassKg_Calc == each,"SCORE"] <- bcPower(x,box_cox_df[box_cox_df$WeightclassKg == each,"lambda"])
}
# divide by mean
for (each in weightclasses){
  data.working[data.working$WeightclassKg_Calc == each,"SCORE"] <- scale(data.working[data.working$WeightclassKg_Calc == each,"SCORE"])
}

visualize box cox results

# individual weight classes
for (each in weightclasses){
  tmp <- data.working %>%
    filter(WeightclassKg_Calc == each) %>%
    select(SCORE)
  
  gg <- ggplot(tmp) +
    geom_density(aes(x = SCORE)) +
    ggtitle(each)
  
  print(gg)
}

# male / female
for (each in c("M", "F")){
  print(ggplot(data.working %>% filter(Sex == each)) +
    geom_point((aes(x = BodyweightKg, y = SCORE))) +
    ggtitle(paste("Gender =",each)))
}

Top Men & Women

data.working %>%
  arrange(desc(SCORE)) %>%
  filter(Sex == "M") %>%
  filter(row_number() <11)

data.working %>%
  arrange(desc(SCORE)) %>%
  filter(Sex == "F") %>%
  filter(row_number() <11)

NA